////////////////////////////////////////////////////////////////////////////
// PaxCompiler
// Site: http://www.paxcompiler.com
// Author: Alexander Baranovsky (paxscript@gmail.com)
// ========================================================================
// Copyright (c) Alexander Baranovsky, 2006-2011. All rights reserved.
// Code Version: 3.1
// ========================================================================
// Unit: PAXCOMP_IMPORT.pas
// ========================================================================
////////////////////////////////////////////////////////////////////////////

{$I PaxCompiler.def}
unit PAXCOMP_IMPORT;
interface
uses
{$IFDEF VARIANTS}
  Variants,
{$ENDIF}
  SysUtils,
  Classes,
  PAXCOMP_SYS,
  PAXCOMP_CONSTANTS,
  PAXCOMP_KERNEL,
  PAXCOMP_BYTECODE,
  PAXCOMP_STDLIB,
  PAXCOMP_BASESYMBOL_TABLE,
  PAXCOMP_SYMBOL_REC,
  PAXCOMP_SYMBOL_TABLE;

const
  MaxLines = 1000;

procedure GenImport(kernel: TKernel;
                    L: TStrings;
                    StCard: Integer;
                    const ImportUnitName: String);

implementation

uses
  paxcomp_dump;

function CheckProc(const TypeName: String; Data: Pointer;
                   errKind: TExternRecKind): Boolean;
begin
  result := false;
end;

procedure GenImport(kernel: TKernel;
                    L: TStrings;
                    StCard: Integer;
                    const ImportUnitName: String);

var
  GTable: TBaseSymbolTable;
  H_NS, H_SUB, H_TYPE: Integer;

  function ProcessSub(Id: Integer): Integer; forward;
  function ProcessProcType(Id: Integer): Integer; forward;
  function ProcessClassType(Id: Integer): Integer; forward;
  function ProcessClassRefType(Id: Integer): Integer; forward;
  function ProcessInterfaceType(Id: Integer): Integer; forward;
  function ProcessRecordType(Id: Integer): Integer; forward;
  function ProcessArrayType(Id: Integer): Integer; forward;
  function ProcessDynArrayType(Id: Integer): Integer; forward;
  function ProcessSetType(Id: Integer): Integer; forward;
  function ProcessPointerType(Id: Integer): Integer; forward;
  function ProcessAliasType(Id: Integer): Integer; forward;
  function ProcessSubrangeType(Id: Integer): Integer; forward;
  function ProcessShortstringType(Id: Integer): Integer; forward;
  function ProcessEnumType(Id: Integer): Integer; forward;
  function ProcessConst(Id: Integer): Integer; forward;

  function CallConvStr(R: TSymbolRec): String;
  begin
    case R.CallConv of
      0: result := '_ccREGISTER';
      ccSTDCALL: result := '_ccSTDCALL';
      ccREGISTER: result := '_ccREGISTER';
      ccCDECL: result := '_ccCDECL';
      ccPASCAL: result := '_ccPASCAL';
      ccSAFECALL: result := '_ccSAFECALL';
      ccMSFASTCALL: result := '_ccMSFASTCALL';
    else
      raise Exception.Create(errInternalError);
    end;
  end;

  function CallModeStr(R: TSymbolRec): String;
  begin
    case R.CallMode of
      cmNONE: result := '_cmNONE';
      cmVIRTUAL: result := '_cmVIRTUAL';
      cmOVERRIDE: result := '_cmOVERRIDE';
    else
      raise Exception.Create(errInternalError);
    end;
  end;

  function Tab(L: Integer): String;
  var
    I: Integer;
  begin
    result := '';
    for I:=1 to L do
      result := result + ' ';
  end;

var
  LP, L1, L2, LU: TStringList;
  Code: TCode;
  SymbolTable: TSymbolTable;
  Op: Integer;

  procedure AddLine(const S: String);
  begin
    L.Add(S);
  end;

  procedure AddP(const S: String);
  begin
    LP.Add(S);
  end;

  procedure Add1(const S: String);
  begin
    if L1.IndexOf(S) = -1 then
      L1.Add(S);
  end;

  procedure Add2(const S: String);
  begin
    L2.Add(S);
  end;

  procedure AddUnit(const S: String);
  var
    I: Integer;
  begin
    for I:=0 to LU.Count - 1 do
      if StrEql(LU[I], S) then
        Exit;
    LU.Add(S);
  end;

  procedure AddUnits;
  var
    I: Integer;
  begin
    AddLine('uses');
    for I:=0 to LU.Count - 1 do
      if I < LU.Count - 1 then
        AddLine(Tab(2) + LU[I] + ',')
      else
        AddLine(Tab(2) + LU[I] + ';');
  end;

  function StrLiteral(const S: String): String;
  begin
    result := '''' + S + '''';
  end;

  function UpdateTypeId(GTableRecNo: Integer; OldTypeId: Integer): Integer;
  var
    S: String;
  begin
    if OldTypeId < Types.Count then
    begin
      result := OldTypeId;
      Exit;
    end;
    S := SymbolTable[OldTypeId].FullName;
    result := GTable.LookupFullName(S, true);
    if result > 0 then
      Exit;
    GTable.ExternList.Add(GTableRecNo,
                          S,
                          erTypeId);
  end;

  function ProcessOldType(OldTypeId: Integer): Integer;
  var
    S: String;
    I: Integer;
    R: TCodeRec;
  begin
    if OldTypeId < Types.Count then
    begin
      result := OldTypeId;
      Exit;
    end;
    S := SymbolTable[OldTypeId].FullName;
    result := GTable.LookupFullName(S, true);
    if result > 0 then
      Exit;
    for I:=1 to Code.Card do
      if Code[I].Arg1 = OldTypeId then
      begin
        R := Code[I];
        Op := R.Op;

        R.Op := OP_NOP;
        if Op = OP_BEGIN_PROC_TYPE then
        begin
          result := ProcessProcType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_ALIAS_TYPE then
        begin
          result := ProcessAliasType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_CLASS_TYPE then
        begin
          result := ProcessClassType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_CLASSREF_TYPE then
        begin
          result := ProcessClassRefType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_INTERFACE_TYPE then
        begin
          result := ProcessInterfaceType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_RECORD_TYPE then
        begin
          result := ProcessRecordType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_ARRAY_TYPE then
        begin
          result := ProcessArrayType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_DYNARRAY_TYPE then
        begin
          result := ProcessDynArrayType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_SUBRANGE_TYPE then
        begin
          result := ProcessSubrangeType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_ENUM_TYPE then
        begin
          result := ProcessEnumType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_SET_TYPE then
        begin
          result := ProcessSetType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_POINTER_TYPE then
        begin
          result := ProcessPointerType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_SHORTSTRING_TYPE then
        begin
          result := ProcessShortstringType(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_SUB then
        begin
          result := ProcessSub(R.Arg1);
          break;
        end
        else if Op = OP_BEGIN_CONST then
        begin
          result := ProcessConst(R.Arg1);
          break;
        end
      end;
  end;

  function UpdateLevelId(R: TSymbolRec): Integer;
  var
    S: String;
  begin
    result := R.Level;
    if result > 0 then
    begin
      S := SymbolTable[result].FullName;
      result := GTable.LookupFullName(S, true);
    end;
  end;

  function ProcessNamespace(Id: Integer): Integer;
  var
    S: String;
  begin
    S := SymbolTable[Id].Name;
    result := GTable.RegisterNamespace(0, S);
    H_NS := result;
  end;

  function ProcessConst(Id: Integer): Integer;
  var
    ConstID, LevelId, ConstTypeId: Integer;
    ConstName: String;
  begin
    ConstId := Id;

    if SymbolTable[ConstId].OwnerId > 0 then
    begin
      result := 0;
      Exit;
    end;

    LevelId := SymbolTable[ConstId].Level;
    if LevelId = 0 then
      LevelId := 0
    else if SymbolTable[LevelId].Kind = kindNAMESPACE then
      LevelId := H_NS
    else
      LevelId := UpdateLevelId(SymbolTable[ConstId]);

    ConstName := SymbolTable[ConstId].Name;
    ConstTypeId := ProcessOldType(SymbolTable[ConstId].TypeID);

    result := GTable.RegisterConstant(LevelId, ConstName, ConstTypeId,
           SymbolTable[ConstId].Value);
  end;

  function ProcessSub(Id: Integer): Integer;
  var
    I, SubID, LevelId, ResTypeId, CallConv, ParamId, ParamTypeId: Integer;
    SubName: String;
    SR: TSymbolRec;
    IsMethod, InsideBody: Boolean;
    CodeRec: TCodeRec;
  begin
    IsMethod := false;

    InsideBody := false;

    for I:=1 to Code.Card do
    begin
      CodeRec := Code[I];
      if CodeRec.Op = OP_BEGIN_SUB then
      begin
        if CodeRec.Arg1 = Id then
        begin
          CodeRec.Op := OP_NOP;
          InsideBody := true;
        end;
      end
      else if CodeRec.Op = OP_END_SUB then
      begin
        if CodeRec.Arg1 = Id then
        begin
          CodeRec.Op := OP_NOP;
          InsideBody := false;
        end;
      end
      else if CodeRec.Op = OP_BEGIN_DYNARRAY_TYPE then
      begin
        if InsideBody then
        begin
          ProcessDynarrayType(CodeRec.Arg1);
          CodeRec.Op := OP_NOP;
        end;
      end;
    end;

    SubId := Id;

    for I:=0 to SymbolTable[SubId].Count - 1 do
    begin
      ParamId := SymbolTable.GetParamId(SubId, I);
      SR := SymbolTable[ParamId];
      if SR.TypeID = 0 then
      begin
        result := 0;
        Exit;
      end;
    end;

    LevelId := SymbolTable[SubId].Level;
    if LevelId = 0 then
      LevelId := 0
    else if SymbolTable[LevelId].Kind = kindNAMESPACE then
      LevelId := H_NS
    else
    begin
      LevelId := H_TYPE;
      IsMethod := true;

      if SymbolTable[SubId].Vis <> cvPublic then
      begin
        result := 0;
        Exit;
      end;
    end;

    SubName := SymbolTable[SubId].Name;
    CallConv := SymbolTable[SubId].CallConv;

    if SubName <> '' then
      if SubName[1] = '_' then
      begin
        result := 0;
        Exit;
      end;

    ResTypeId := UpdateTypeId(GTable.Card + 1, SymbolTable[SubId].TypeID);

    if IsMethod then
      case SymbolTable[SubId].Kind of
        kindCONSTRUCTOR: H_SUB := GTable.RegisterConstructor(LevelId, SubName, nil, ccREGISTER);
        kindDESTRUCTOR: H_SUB := GTable.RegisterDestructor(LevelId, SubName, nil, ccREGISTER);
        else
          H_SUB := GTable.RegisterMethod(LevelId,
                                         SubName,
                                         ResTypeId,
                                         CallConv,
                                         nil,
                                         SymbolTable[SubId].IsSharedMethod,
                                         SymbolTable[SubId].CallMode,
                                         SymbolTable[SubId].MethodIndex);
      end
    else
      H_SUB := GTable.RegisterRoutine(LevelId, SubName, ResTypeId, CallConv, nil);

    GTable[GTable.LastSubId].OverCount := SymbolTable[SubId].OverCount;

    result := H_SUB;

    for I:=0 to SymbolTable[SubId].Count - 1 do
    begin
      ParamId := SymbolTable.GetParamId(SubId, I);
      SR := SymbolTable[ParamId];

      ParamTypeId := UpdateTypeId(GTable.Card + 1, SR.TypeID);

      GTable.RegisterParameter(H_SUB, ParamTypeId,
        SR.Value, SR.ByRef, SR.Name);
      if SR.IsConst then
        GTable[GTable.Card].IsConst := true;
    end;
  end;

  function ProcessProcType(Id: Integer): Integer;
  var
    LevelId, TypeId, DummySubId, FinTypeId: Integer;
    TypeName: String;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;
    DummySubId := SymbolTable[TypeId].PatternId;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    DummySubId := ProcessOldType(DummySubId);

    FinTypeId := SymbolTable[TypeId].FinalTypeId;

    case FinTypeId of
      typePROC: result := GTable.RegisterProceduralType(LevelId,
                                                         TypeName,
                                                         DummySubId);
      typeEVENT: result := GTable.RegisterEventType(LevelId,
                                                    TypeName,
                                                    DummySubId);
    else
      raise Exception.Create(errInternalError);
    end;
  end;

  function ProcessSubrangeType(Id: Integer): Integer;
  var
    LevelId, TypeId, TypeBaseId: Integer;
    TypeName: String;
    B1, B2: Integer;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    TypeBaseId := ProcessOldType(SymbolTable[TypeId].TypeId);
    B1 := SymbolTable.GetLowBoundRec(TypeId).Value;
    B2 := SymbolTable.GetHighBoundRec(TypeId).Value;

    result := GTable.RegisterSubrangeType(LevelId,
                                          TypeName,
                                          TypeBaseId,
                                          B1, B2);
  end;

  function ProcessEnumType(Id: Integer): Integer;
  var
    I, LevelId, TypeId, TypeBaseId: Integer;
    TypeName: String;
    RI: TSymbolRec;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    TypeBaseId := SymbolTable[TypeId].PatternId;

    TypeBaseId := ProcessOldType(TypeBaseId);

    result := GTable.RegisterEnumType(LevelId,
                                      TypeName,
                                      TypeBaseId);

    for I:=TypeId + 1 to SymbolTable.Card do
    begin
      RI := SymbolTable[I];
      if RI.OwnerId = TypeId then
        GTable.RegisterEnumValue(result,
                                 RI.Name,
                                 RI.Value);
    end;
  end;

  function ProcessSetType(Id: Integer): Integer;
  var
    LevelId, TypeId, OriginTypeId: Integer;
    TypeName: String;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    OriginTypeId := SymbolTable[TypeId].PatternId;

    OriginTypeId := ProcessOldType(OriginTypeId);

    result := GTable.RegisterSetType(LevelId,
                                     TypeName,
                                     OriginTypeId);
  end;

  function ProcessPointerType(Id: Integer): Integer;
  var
    LevelId, TypeId, OriginTypeId: Integer;
    TypeName: String;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    OriginTypeId := SymbolTable[TypeId].PatternId;

    OriginTypeId := ProcessOldType(OriginTypeId);

    result := GTable.RegisterPointerType(LevelId,
                                         TypeName,
                                         OriginTypeId);
  end;

  function ProcessAliasType(Id: Integer): Integer;
  var
    LevelId, TypeId, OriginTypeId: Integer;
    TypeName: String;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    OriginTypeId := SymbolTable[TypeId].PatternId;
    OriginTypeId := ProcessOldType(OriginTypeId);

    result := GTable.RegisterTypeAlias(LevelId,
                                       TypeName,
                                       OriginTypeId);
  end;

  function ProcessShortstringType(Id: Integer): Integer;
  var
    LevelId, TypeId, L: Integer;
    TypeName: String;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;
    L := SymbolTable[TypeId].Count;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    result := GTable.RegisterShortstringType(LevelId,
                                         TypeName,
                                         L);
  end;

  function ProcessClassType(Id: Integer): Integer;
  var
    I, J, K: Integer;
    LevelId, TypeId, FieldTypeId, ReadId, WriteId, ParamTypeId, PropId,
    _ReadId, _WriteId: Integer;
    TypeName, SubName: String;
    RI, RJ: TSymbolRec;
  begin
    TypeId := Id;

    _ReadId := 0;
    _WriteId := 0;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    H_TYPE := GTable.RegisterClassTypeForImporter(LevelId, TypeName);
    result := H_TYPE;

    for I:=TypeId + 1 to SymbolTable.Card do
    begin
      RI := SymbolTable[I];

      if RI.Vis <> cvPublic then
        continue;

      if RI.Level = TypeId then
        case RI.Kind of
          kindTYPE_FIELD:
          begin
            FieldTypeId := UpdateTypeId(GTable.Card + 1, RI.TypeID);
            GTable.RegisterTypeField(H_TYPE,
                                     RI.Name,
                                     FieldTypeID,
                                     RI.Shift);
          end;
          kindPROP:
          begin
            FieldTypeId := UpdateTypeId(GTable.Card + 1, RI.TypeID);
            if RI.ReadId > 0 then
            begin
              SubName := '@R_' + RI.FullName;
              SubName := StringReplace(SubName, '.', '_', [rfReplaceAll, rfIgnoreCase]);

              _ReadId :=  GTable.Card + 1;

              ReadId := GTable.RegisterMethod(LevelId, SubName, FieldTypeId, ccSTDCALL, nil);

              K := 0;

              for J:=I + 1 to SymbolTable.Card do
              begin
                RJ := SymbolTable[J];
                if RJ.Level = I then
                if RJ.Kind = kindVAR then
                if RJ.Name <> '' then
                begin
                  Inc(K);

                  ParamTypeId := UpdateTypeId(GTable.Card + 1, RJ.TypeID);

                  GTable.RegisterParameter(ReadId, ParamTypeId,
                    RJ.Value, RJ.ByRef, RJ.Name);
                  if RJ.IsConst then
                    GTable[GTable.Card].IsConst := true;

                  if K = RI.Count then
                    break;
                end;
              end;

            end
            else
              ReadId := 0;

            if RI.WriteId > 0 then
            begin
              SubName := '@W_' + RI.FullName;
              SubName := StringReplace(SubName, '.', '_', [rfReplaceAll, rfIgnoreCase]);

              _WriteId :=  GTable.Card + 1;

              WriteId := GTable.RegisterMethod(LevelId, SubName, typeVOID, ccSTDCALL, nil);

              K := 0;

              for J:=I + 1 to SymbolTable.Card do
              begin
                RJ := SymbolTable[J];
                if RJ.Level = I then
                if RJ.Kind = kindVAR then
                if RJ.Name <> '' then
                begin
                  Inc(K);

                  ParamTypeId := UpdateTypeId(GTable.Card + 1, RJ.TypeID);

                  GTable.RegisterParameter(WriteId, ParamTypeId,
                    RJ.Value, RJ.ByRef, RJ.Name);
                  if RJ.IsConst then
                    GTable[GTable.Card].IsConst := true;

                  if K = RI.Count then
                    break;
                end;
              end;

              FieldTypeId := UpdateTypeId(GTable.Card + 1, RI.TypeID);
              GTable.RegisterParameter(WriteId, FieldTypeId,
                                     Unassigned, false, 'Value');
              GTable[GTable.Card].IsConst := true;
            end
            else
              WriteId := 0;

            PropId := GTable.RegisterProperty(H_TYPE,
                                              RI.Name,
                                              FieldTypeId,
                                              ReadId,
                                              WriteId,
                                              RI.IsDefault);

            if RI.ReadId > 0 then
              GTable[_ReadId].Position := PropId;
            if RI.WriteId > 0 then
              GTable[_WriteId].Position := PropId;

          end;
          kindSUB, kindCONSTRUCTOR, kindDESTRUCTOR:
          begin
            ProcessSub(I);
          end;
        end;
    end;
  end;

  function ProcessClassRefType(Id: Integer): Integer;
  var
    LevelId, TypeId, OriginTypeId: Integer;
    TypeName: String;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;
    OriginTypeId := SymbolTable[TypeId].PatternId;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    OriginTypeId := ProcessOldType(OriginTypeId);

    result := GTable.RegisterClassReferenceType(LevelId,
                                               TypeName,
                                               OriginTypeId);
  end;

  function ProcessInterfaceType(Id: Integer): Integer;
  var
    I: Integer;
    LevelId, TypeId, FieldTypeId: Integer;
    TypeName: String;
    RI: TSymbolRec;
    GUID: TGUID;
    D: packed record D1, D2: Double end;
    ReadIndex, WriteIndex: Integer;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;
    D.D1 := SymbolTable[TypeId+1].Value;
    D.D2 := SymbolTable[TypeId+2].Value;
    GUID := TGUID(D);

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    H_TYPE := GTable.RegisterInterfaceType(LevelId, TypeName, GUID);
    result := H_TYPE;

    for I:=TypeId + 1 to SymbolTable.Card do
    begin
      RI := SymbolTable[I];

      if RI.Vis <> cvPublic then
        continue;

      if RI.Level = TypeId then
        case RI.Kind of
          kindPROP:
          begin
            FieldTypeId := UpdateTypeId(GTable.Card + 1, RI.TypeID);
            if RI.ReadId > 0 then
              ReadIndex := SymbolTable[RI.ReadId].MethodIndex
            else
              ReadIndex := 0;
            if RI.WriteId > 0 then
              WriteIndex := SymbolTable[RI.ReadId].MethodIndex
            else
              WriteIndex := 0;
            GTable.RegisterInterfaceProperty(H_TYPE,
                                             RI.Name,
                                             FieldTypeId,
                                             ReadIndex,
                                             WriteIndex);
          end;
          kindSUB:
          begin
            ProcessSub(I);
          end;
        end;
    end;
  end;

  function ProcessRecordType(Id: Integer): Integer;
  var
    I, K: Integer;
    LevelId, TypeId, Align, FieldTypeId: Integer;
    TypeName: String;
    RI: TSymbolRec;
    L: TIntegerList;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;
    Align := SymbolTable[TypeId].DefaultAlignment;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    L := TIntegerList.Create;
    for I:=TypeId + 1 to SymbolTable.Card do
    begin
      RI := SymbolTable[I];
      if RI.Level = TypeId then
        if RI.Kind = kindTYPE_FIELD then
        begin
          FieldTypeId := ProcessOldType(RI.TypeID);
          L.Add(FieldTypeId);
        end;
    end;

    try

      H_TYPE := GTable.RegisterRecordType(LevelId, TypeName, Align);
      result := H_TYPE;

      K := -1;

      for I:=TypeId + 1 to SymbolTable.Card do
      begin
        RI := SymbolTable[I];
        if RI.Level = TypeId then
          if RI.Kind = kindTYPE_FIELD then
          begin
            Inc(K);
            FieldTypeId := L[K];
            GTable.RegisterTypeField(H_TYPE,
                                     RI.Name,
                                     FieldTypeID,
                                     RI.Shift);
          end;
      end;

    finally
      L.Free;
    end;
  end;

  function ProcessArrayType(Id: Integer): Integer;
  var
    LevelId, TypeId, Align, RangeTypeId, ElemTypeId: Integer;
    TypeName: String;
  begin
    TypeId := Id;

    SymbolTable.GetArrayTypeInfo(TypeId, RangeTypeId, ElemTypeId);

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;
    Align := SymbolTable[TypeId].DefaultAlignment;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    RangeTypeId := ProcessOldType(RangeTypeId);
    ElemTypeId := ProcessOldType(ElemTypeId);

    result := GTable.RegisterArrayType(LevelId, TypeName,
       RangeTypeId, ElemTypeId, Align);
  end;

  function ProcessDynArrayType(Id: Integer): Integer;
  var
    LevelId, TypeId, ElemTypeId: Integer;
    TypeName: String;
  begin
    TypeId := Id;

    LevelId := H_NS;
    TypeName := SymbolTable[TypeId].Name;
    ElemTypeId := SymbolTable[TypeId].PatternId;

    if TypeName = '' then
    begin
      result := 0;
      Exit;
    end;

    ElemTypeId := ProcessOldType(ElemTypeId);

    result := GTable.RegisterDynamicArrayType(LevelId, TypeName,
       ElemTypeId);
  end;

  function GetStrTypeConst(TypeId: Integer): String;
  var
    T: Integer;
    S: String;
  begin
    if TypeId in [0, typeVOID] then
      result := '_typeVOID'
    else
    begin
      if TypeId >= FirstLocalId then
        T := TypeId - FirstLocalId + StCard
      else
        T := TypeId;

      S := GTable[TypeId].Name;
      if PosCh('#', S) > 0 then
        S := RemoveCh('#', S);

      if PosCh('$', S) > 0 then
        S := 'AType';

      result := S + '_' + IntToStr(T);

      Add1('const ' + result + ' = ' + IntToStr(T) + '; // ' + IntToStr(TypeId));
    end;
  end;

  function GetTypeName(R: TSymbolRec): String;
  var
    T: Integer;
  begin
    result := GTable[R.TypeId].Name;
    if R.FinalTypeId = typeDYNARRAY then
    begin
      if Pos('DynarrayType_', result) = 1 then
      begin
        T := GTable[R.TypeID].PatternId;
        if T = H_TVarRec then
          result := 'array of const'
        else
          result := 'array of ' + GTable[T].Name;
      end;
    end;
  end;

  function CheckSub(SubId: Integer): Boolean;
  var
    I, ParamId: Integer;
  begin
    result := true;
    if GTable[SubId].TypeID = 0 then
    begin
      result := false;
      Exit;
    end;
    for I:=0 to GTable[SubId].Count - 1 do
    begin
      ParamId := GTable.GetParamId(SubId, I);
      if GTable[ParamId].TypeID = 0 then
      begin
        result := false;
        Exit;
      end;
    end;
  end;

  function SubSize(SubId: Integer): Integer;
  var
    K: Integer;
  begin
    K := GTable[SubId].Count;
    if K = 0 then
      result := 3
    else
      result := GTable.GetParamId(SubId, K - 1) - SubId + 1;
  end;

  function CheckProp(PropId: Integer): Boolean;
  begin
    result := GTable[PropId].TypeID <> 0;
  end;

  function PropSize(PropId: Integer): Integer;
  begin
    result := 2;
  end;

var
  RegProcName: String;
  T, KK, I, J, K, RangeTypeId, ElemTypeId, TotalOverCount: Integer;
  RI, RJ: TSymbolRec;
  R: TCodeRec;

  S, StrLevelConst, StrTypeConst, StrCallConv, StrCallMode, StrAddress, StrValue,
  SubName, TypeName, StrRead, StrWrite: String;
  NewKernel: TKernel;
  RegisteredClasses: TStringList;
begin
  RegProcName := 'Register_' + ImportUnitName;
  Code := TKernel(kernel).Code;
  SymbolTable := TKernel(kernel).SymbolTable;

  LP := TStringList.Create;
  L1 := TStringList.Create;
  L2 := TStringList.Create;
  LU := TStringList.Create;
  RegisteredClasses := TStringList.Create;

  NewKernel := TKernel.Create(nil);
  GTable := NewKernel.SymbolTable;

  try
    AddUnit('Types');
    AddUnit('Classes');
    AddUnit('PaxCompiler');
    AddUnit('PaxRegister');

    for I:=1 to Code.Card do
    begin
      R := Code[I];
      Op := R.Op;
      if Op = OP_BEGIN_NAMESPACE then
        ProcessNamespace(R.Arg1)
      else if Op = OP_BEGIN_PROC_TYPE then
        ProcessProcType(R.Arg1)
      else if Op = OP_BEGIN_ALIAS_TYPE then
        ProcessAliasType(R.Arg1)
      else if Op = OP_BEGIN_INTERFACE_TYPE then
        ProcessInterfaceType(R.Arg1)
      else if Op = OP_BEGIN_CLASS_TYPE then
        ProcessClassType(R.Arg1)
      else if Op = OP_BEGIN_CLASSREF_TYPE then
        ProcessClassRefType(R.Arg1)
      else if Op = OP_BEGIN_RECORD_TYPE then
        ProcessRecordType(R.Arg1)
      else if Op = OP_BEGIN_ARRAY_TYPE then
        ProcessArrayType(R.Arg1)
      else if Op = OP_BEGIN_DYNARRAY_TYPE then
        ProcessDynArrayType(R.Arg1)
      else if Op = OP_BEGIN_SUBRANGE_TYPE then
        ProcessSubrangeType(R.Arg1)
      else if Op = OP_BEGIN_ENUM_TYPE then
        ProcessEnumType(R.Arg1)
      else if Op = OP_BEGIN_SET_TYPE then
        ProcessSetType(R.Arg1)
      else if Op = OP_BEGIN_POINTER_TYPE then
        ProcessPointerType(R.Arg1)
      else if Op = OP_BEGIN_SHORTSTRING_TYPE then
        ProcessShortstringType(R.Arg1)
      else if Op = OP_BEGIN_SUB then
        ProcessSub(R.Arg1)
      else if Op = OP_BEGIN_CONST then
        ProcessConst(R.Arg1);
      R.Op := OP_NOP;
    end;

    GTable.ResolveExternList(CheckProc, nil);

    TotalOverCount := 0;

    for I:=FirstLocalId + 1 to GTable.Card do
    begin
      RI := GTable[I];

      KK := I - FirstLocalId + StCard;

      if Length(RI.Name) = 0 then
        continue;

      case RI.Kind of
        KindNAMESPACE:
        begin
          AddUnit(RI.Name);

          Add2(Tab(2) + 'H_NS := ' + 'RegisterNamespace(0, ' +
            StrLiteral(RI.Name) +
            ');' + '//' + IntToStr(KK));
        end;
        KindCONST:
        begin
          If RI.OwnerId > 0 then
            continue;

          If RI.Level = 0 then
            StrLevelConst := '0'
          else if GTable[RI.Level].Kind = kindNAMESPACE then
            StrLevelConst := 'H_NS';
          StrTypeConst := GetStrTypeConst(RI.TypeId);
          StrValue := GTable.ValueStr(I);
          if PosCh('[', StrValue) > 0 then
            StrValue := '0';
          if RI.FinalTypeId in StringTypes then
            StrValue := '''' + StrValue + '''';
          if RI.HasPAnsiCharType then
            StrValue := '''' + StrValue + '''';
          Add2(Tab(2) + 'RegisterConstant(' +
            StrLevelConst + ',' +
            StrLiteral(RI.Name) + ',' +
            StrTypeConst + ',' +
            StrValue +
            ');' + '//' + IntToStr(KK));
        end;
        KindSUB, kindCONSTRUCTOR, kindDESTRUCTOR:
        begin
          if not CheckSub(I) then
          begin
            Add2(Tab(2) + '// Cannot import "' + RI.FullName + '"');
            Add2(Tab(2) + 'RegisterSpace(' +  IntToStr(SubSize(I)) + ');');
            continue;
          end;

          If RI.Level = 0 then
            StrLevelConst := '0'
          else if GTable[RI.Level].Kind = kindNAMESPACE then
            StrLevelConst := 'H_NS'
          else
            StrLevelConst := 'H_TYPE';

          StrTypeConst := GetStrTypeConst(RI.TypeId);

          StrCallConv :=  CallConvStr(RI);
          StrCallMode := CallModeStr(RI);

          if PosCh('#', RI.Name) = 1 then
            StrAddress := 'nil'
          else
            StrAddress := '@' + RI.FullName;

          case RI.Kind of
            kindCONSTRUCTOR:
            begin
              if RI.OverCount > 0 then
              begin
                Inc(TotalOverCount);
                SubName := RI.FullName + '__' + IntToStr(TotalOverCount);
                SubName := StringReplace(SubName, '.', '_', [rfReplaceAll, rfIgnoreCase]);

                StrAddress := '@' + SubName;

                S := 'function ' + SubName + '(';

                for J:=0 to RI.Count - 1 do
                begin
                  RJ := GTable[GTable.GetParamId(I, J)];
                  if RJ.IsConst then
                    S := S + 'const '
                  else if RJ.ByRef then
                    S := S + 'var ';
                  S := S + RJ.Name;
                  if not StrEql(GetTypeName(RJ), 'PVOID') then
                    S := S + ':' + GetTypeName(RJ);
                  if J <> RI.Count - 1 then
                    S := S + ';'
                end;

                S := S + '):' + GTable[RI.TypeId].Name + ';';

                AddP(S);
                AddP('begin');

                S := 'result := ' + GTable[RI.TypeId].Name + '.' + RI.Name + '(';
                for J:=0 to RI.Count - 1 do
                begin
                  RJ := GTable[GTable.GetParamId(I, J)];
                  S := S + RJ.Name;
                  if J <> RI.Count - 1 then
                    S := S + ','
                end;
                S := S + ');';

                AddP(Tab(2) + S);
                AddP('end;');

                Add2(Tab(2) + 'H_SUB := ' + 'RegisterMethod(' +
                  StrLevelConst + ',' +
                  StrLiteral(RI.Name) + ',' +
                  StrTypeConst + ',' +
                  StrAddress + ',' +
                  StrCallConv + ',' +
                  'true' +
                  ');' + '//' + IntToStr(KK));
              end
              else
                Add2(Tab(2) + 'H_SUB := ' + 'RegisterConstructor(' +
                  StrLevelConst + ',' +
                  StrLiteral(RI.Name) + ',' +
                  StrAddress +
                  ');' + '//' + IntToStr(KK));
            end;
            kindDESTRUCTOR:
              Add2(Tab(2) + 'RegisterDestructor(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) + ',' +
                StrAddress +
                ');' + '//' + IntToStr(KK));
            else
              if StrLevelConst = 'H_TYPE' then
              begin
                if RI.OverCount > 0 then
                begin
                  Inc(TotalOverCount);
                  SubName := RI.FullName + '__' + IntToStr(TotalOverCount);
                  SubName := StringReplace(SubName, '.', '_', [rfReplaceAll, rfIgnoreCase]);

                  StrAddress := '@' + SubName;

                  if RI.TypeID in [0, typeVOID] then
                    S := 'procedure '
                  else
                    S := 'function ';
                  S := S + SubName + '(Self:' + GTable[RI.Level].Name;

                  if RI.Count <> 0 then
                    S := S + ';';

                  for J:=0 to RI.Count - 1 do
                  begin
                    RJ := GTable[GTable.GetParamId(I, J)];
                    if RJ.IsConst then
                      S := S + 'const '
                    else if RJ.ByRef then
                      S := S + 'var ';
                    S := S + RJ.Name;
                    if not StrEql(GetTypeName(RJ), 'PVOID') then
                      S := S + ':' + GetTypeName(RJ);
                    if J <> RI.Count - 1 then
                      S := S + ';'
                  end;

                  S := S + ')';

                  if not (RI.TypeID in [0, typeVOID]) then
                    S := S + ':' + GTable[RI.TypeId].Name;

                  S := S + ';' + Copy(StrCallConv, 4, Length(StrCallConv) - 3) + ';';

                  AddP(S);
                  AddP('begin');

                  if not (RI.TypeID in [0, typeVOID]) then // procedure
                    S := 'result := Self.'
                  else
                    S := 'Self.';

                  S := S + RI.Name + '(';
                  for J:=0 to RI.Count - 1 do
                  begin
                    RJ := GTable[GTable.GetParamId(I, J)];
                    S := S + RJ.Name;
                    if J <> RI.Count - 1 then
                      S := S + ','
                  end;
                  S := S + ');';

                  AddP(Tab(2) + S);
                  AddP('end;');

                end;

                if RI.Level > 0 then
                  if GTable[RI.Level].FinalTypeId = typeINTERFACE then
                    StrAddress := 'nil';

                Add2(Tab(2) + 'H_SUB := ' + 'RegisterMethod(' +
                  StrLevelConst + ',' +
                  StrLiteral(RI.Name) + ',' +
                  StrTypeConst + ',' +
                  StrAddress + ',' +
                  StrCallConv + ',' +
                  BoolToStr(RI.IsSharedMethod, true) + ',' +
                  StrCallMode + ',' +
                  IntToStr(RI.MethodIndex) +
                  ');' + '//' + IntToStr(KK));
              end
            else
            begin
              if PosCh('@', RI.Name) = 1 then
              begin
                SubName :=  RI.Name;
                TypeName := GTable[Gtable[RI.Position].Level].Name;

                if RI.Name[2] = 'R' then
                begin
                  SubName := StringReplace(SubName, '@', '', [rfReplaceAll, rfIgnoreCase]);

                  S := 'function ' + SubName + '(Self:' + TypeName;
                  if RI.Count <> 0 then
                    S := S + ';';

                  for J:=0 to RI.Count - 1 do
                  begin
                    RJ := GTable[GTable.GetParamId(I, J)];
                    if RJ.IsConst then
                      S := S + 'const '
                    else if RJ.ByRef then
                      S := S + 'var ';
                    S := S + RJ.Name;
                    if not StrEql(GetTypeName(RJ), 'PVOID') then
                      S := S + ':' + GetTypeName(RJ);
                    if J <> RI.Count - 1 then
                      S := S + ';'
                  end;
                  S := S + '):' + GTable[RI.TypeId].Name + '; stdcall;';
                  AddP(S);
                  AddP('begin');
                  S := 'result := Self.' + Gtable[RI.Position].Name;
                  if RI.Count > 0 then
                  begin
                    S := S + '[';
                    for J:=0 to RI.Count - 1 do
                    begin
                      RJ := GTable[GTable.GetParamId(I, J)];
                      S := S + RJ.Name;
                      if J <> RI.Count - 1 then
                        S := S + ','
                    end;
                    S := S + ']';
                  end;
                  AddP(Tab(2) + S + ';');
                  AddP('end;');

                  Add2(Tab(2) + 'H_SUB := ' + 'RegisterRoutine(' +
                    StrLevelConst + ',' +
                    StrLiteral(SubName) + ',' +
                    StrTypeConst + ',' +
                    '@' + SubName + ',' +
                    StrCallConv +
                    ');'+ '//' + IntToStr(KK));
                  Add2(Tab(2) + 'H_READ := H_SUB;');
                end
                else
                begin
                  SubName := StringReplace(SubName, '@', '', [rfReplaceAll, rfIgnoreCase]);

                  S := 'procedure ' + SubName + '(Self:' + TypeName;
                  if RI.Count <> 0 then
                    S := S + ';';

                  for J:=0 to RI.Count - 1 do
                  begin
                    RJ := GTable[GTable.GetParamId(I, J)];
                    if RJ.IsConst then
                      S := S + 'const '
                    else if RJ.ByRef then
                      S := S + 'var ';
                    S := S + RJ.Name;
                    if not StrEql(GetTypeName(RJ), 'PVOID') then
                      S := S + ':' + GetTypeName(RJ);
                    if J <> RI.Count - 1 then
                      S := S + ';'
                  end;
                  S := S + '); stdcall;';
                  AddP(S);
                  AddP('begin');
                  S := 'Self.' + Gtable[RI.Position].Name;
                  if RI.Count > 1 then
                  begin
                    S := S + '[';
                    for J:=0 to RI.Count - 2 do
                    begin
                      RJ := GTable[GTable.GetParamId(I, J)];
                      S := S + RJ.Name;
                      if J <> RI.Count - 2 then
                        S := S + ','
                    end;
                    S := S + ']';
                  end;
                  AddP(Tab(2) + S + ' := value;');
                  AddP('end;');

                  Add2(Tab(2) + 'H_SUB := ' + 'RegisterRoutine(' +
                    StrLevelConst + ',' +
                    StrLiteral(SubName) + ',' +
                    StrTypeConst + ',' +
                    '@' + SubName + ',' +
                    StrCallConv +
                    ');'+ '//' + IntToStr(KK));
                  Add2(Tab(2) + 'H_WRITE := H_SUB;');
                end;
              end
              else
              begin
                if RI.OverCount > 0 then
                begin
                  Inc(TotalOverCount);
                  SubName := RI.Name + '__' + IntToStr(TotalOverCount);

                  StrAddress := '@' + SubName;

                  if RI.TypeID in [0, typeVOID] then
                    S := 'procedure '
                  else
                    S := 'function ';
                  S := S + SubName + '(';

                  for J:=0 to RI.Count - 1 do
                  begin
                    RJ := GTable[GTable.GetParamId(I, J)];
                    if RJ.IsConst then
                      S := S + 'const '
                    else if RJ.ByRef then
                      S := S + 'var ';
                    S := S + RJ.Name;
                    if not StrEql(GetTypeName(RJ), 'PVOID') then
                      S := S + ':' + GetTypeName(RJ);
                    if J <> RI.Count - 1 then
                      S := S + ';'
                  end;

                  S := S + ')';

                  if not (RI.TypeID in [0, typeVOID]) then
                    S := S + ':' + GTable[RI.TypeId].Name;

                  S := S + ';' + Copy(StrCallConv, 4, Length(StrCallConv) - 3) + ';';

                  AddP(S);
                  AddP('begin');

                  S := '';

                  if not (RI.TypeID in [0, typeVOID]) then // procedure
                    S := 'result := ';

                  S := S + RI.Name + '(';
                  for J:=0 to RI.Count - 1 do
                  begin
                    RJ := GTable[GTable.GetParamId(I, J)];
                    S := S + RJ.Name;
                    if J <> RI.Count - 1 then
                      S := S + ','
                  end;
                  S := S + ');';

                  AddP(Tab(2) + S);
                  AddP('end;');

                end;

                Add2(Tab(2) + 'H_SUB := ' + 'RegisterRoutine(' +
                    StrLevelConst + ',' +
                    StrLiteral(RI.Name) + ',' +
                    StrTypeConst + ',' +
                    StrAddress + ',' +
                    StrCallConv +
                    ');'+ '//' + IntToStr(KK));
              end;
            end;
          end;

          Inc(KK, 2);

          for J:=0 to GTable[I].Count - 1 do
          begin
            RJ := GTable[GTable.GetParamId(I, J)];

            if RJ.Optional then
              StrValue := VarToStr(RJ.Value)
            else
              StrValue := 'Undefined';

            Inc(KK);

            Add2(Tab(4) + 'RegisterParameterEx(H_SUB, ' +
                 StrLiteral(RJ.Name) + ',' +
                 GetStrTypeConst(RJ.TypeId) + ',' +
                 StrValue + ',' +
                 BoolToStr(RJ.ByRef, true) +  ',' +
                 BoolToStr(RJ.IsConst, true) +
                ');'+ '//' + IntToStr(KK));
          end;

        end;
        kindPROP:
        begin
          if not CheckProp(I) then
          begin
            Add2(Tab(2) + '// Cannot import "' + RI.FullName + '"');
            Add2(Tab(2) + 'RegisterSpace(' +  IntToStr(PropSize(I)) + ');');
            continue;
          end;

          StrTypeConst := GetStrTypeConst(RI.TypeId);

          if (RI.Level > 0) and (GTable[RI.Level].FinalTypeId = typeINTERFACE) then
          begin
            if RI.ReadId > 0 then
              StrRead := IntToStr(GTable[RI.ReadId].MethodIndex)
            else
              StrRead := '0';

            if RI.WriteId > 0 then
              StrWrite := IntToStr(GTable[RI.WriteId].MethodIndex)
            else
              StrWrite := '0';

            Add2(Tab(2) + 'RegisterInterfaceProperty(H_TYPE,' +
               StrLiteral(RI.Name) + ',' +
               StrTypeConst + ',' +
               StrRead + ',' +
               StrWrite +
            ');' + '//' + IntToStr(KK));
          end
          else
          begin
            if RI.ReadId > 0 then
              StrRead := 'H_READ'
            else
              StrRead := '0';
            if RI.WriteId > 0 then
              StrWrite := 'H_WRITE'
            else
              StrWrite := '0';
            Add2(Tab(2) + 'RegisterProperty(H_TYPE,' +
               StrLiteral(RI.Name) + ',' +
               StrTypeConst + ',' +
               StrRead + ',' +
               StrWrite + ',' +
               BoolToStr(RI.IsDefault, true) +
            ');' + '//' + IntToStr(KK));
          end;
        end;
        kindTYPE:
        begin
          StrLevelConst := 'H_NS';

          T := RI.TypeId;
          if T = typeALIAS then
          begin
            // alias
          end
          else
            T := RI.FinalTypeId;

          case T of
            typeRECORD:
            begin
              Add2(Tab(2) + 'RegisterAlignment(' + IntToStr(RI.DefaultAlignment) + ');');

              Add2(Tab(2) + 'H_TYPE := ' + 'RegisterRecordType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) +
                ');' + '//' + IntToStr(KK));

              for J:=I + 1 to GTable.Card do
              begin
                RJ := GTable[J];
                if RJ.Level = I then
                  if RJ.Kind = kindTYPE_FIELD then
                  begin
                    StrTypeConst := GetStrTypeConst(RJ.TypeId);

                    Inc(KK);

                    Add2(Tab(4) + 'RegisterRecordTypeField(H_TYPE, ' +
                      StrLiteral(RJ.Name) + ',' +
                      StrTypeConst + ',' +
                      IntToStr(RJ.Shift) +
                      ');' + '//' + IntToStr(KK));
                  end;
              end;
            end;
            typeCLASS:
            begin
              Add2(Tab(2) + 'H_TYPE := ' + 'RegisterClassTypeForImporter(' +
                StrLevelConst + ',' +
                RI.Name +
                ');' + '//' + IntToStr(KK));

              RegisteredClasses.AddObject(RI.Name, TObject(KK));

              Inc(KK, 3);

              for J:=I + 1 to GTable.Card do
              begin
                RJ := GTable[J];
                if RJ.Level = I then
                  case RJ.Kind of
                    kindTYPE_FIELD:
                    begin
                      Inc(KK);

                      StrTypeConst := GetStrTypeConst(RJ.TypeId);
                      Add2(Tab(4) + 'RegisterClassTypeField(H_TYPE, ' +
                        StrLiteral(RJ.Name) + ',' +
                        StrTypeConst + ',' +
                        'Integer(@' + GTable[RJ.Level].Name + '(nil).' + RJ.Name + ')' +
                        ');' + '//' + IntToStr(KK));
                    end;
                 end;
              end;
            end;
            typeCLASSREF:
            begin
              Add2(Tab(2) + 'RegisterClassReferenceType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) + ',' +
                GetStrTypeConst(RI.PatternId) +
                ');' + '//' + IntToStr(KK));
            end;
            typeINTERFACE:
            begin
              Add2(Tab(2) + 'H_TYPE := ' + 'RegisterInterfaceType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) + ',' +
                RI.Name +
                ');' + '//' + IntToStr(KK));
            end;
            typeARRAY:
            begin
              Add2(Tab(2) + 'RegisterAlignment(' + IntToStr(1) + ');');

              GTable.GetArrayTypeInfo(I, RangeTypeId, ElemTypeId);
              Add2(Tab(2) + 'RegisterArrayType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) + ',' +
                GetStrTypeConst(RangeTypeId) + ',' +
                GetStrTypeConst(ElemTypeId) +
                ');' + '//' + IntToStr(KK));
            end;
            typeDYNARRAY:
            begin
              Add2(Tab(2) + 'RegisterAlignment(' + IntToStr(1) + ');');

              ElemTypeId := RI.PatternId;

              Add2(Tab(2) + 'RegisterDynamicArrayType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) + ',' +
                GetStrTypeConst(ElemTypeId) +
                ');' + '//' + IntToStr(KK));
            end;
            typeENUM:
            begin
              if (GTable[I+1].Kind = kindCONST) and
                 (GTable[I+1].TypeId = typeENUM) then
              begin
                Add2(Tab(2) + 'RegisterSubrangeType(' +
                  StrLevelConst + ',' +
                  StrLiteral(RI.Name) + ',' +
                  GetStrTypeConst(RI.TypeId) + ',' +
                  IntToStr(GTable.GetLowBoundRec(I).Value) + ',' +
                  IntToStr(GTable.GetHighBoundRec(I).Value) +
                  ');' + '//' + IntToStr(KK));
                continue;
              end;

              Add2(Tab(2) + 'H_TYPE := ' + 'RegisterEnumType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) +
                ');' + '//' + IntToStr(KK));
              for J:=I + 1 to GTable.Card do
              begin
                RJ := GTable[J];
                if RJ.OwnerId = I then
                begin
                  Inc(KK);

                  Add2(Tab(4) + 'RegisterEnumValue(H_TYPE, ' +
                    StrLiteral(RJ.Name) + ',' +
                    IntToStr(RJ.Value) +
                    ');' + '//' + IntToStr(KK));
                end;
              end;
            end;
            typeSET:
            begin
              Add2(Tab(2) + 'RegisterSetType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) + ',' +
                GetStrTypeConst(RI.PatternId) +
                ');' + '//' + IntToStr(KK));
            end;
            typePOINTER:
            begin
              Add2(Tab(2) + 'RegisterPointerType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) + ',' +
                GetStrTypeConst(RI.PatternId) +
                ');' + '//' + IntToStr(KK));
            end;
            typeSHORTSTRING:
            begin
              Add2(Tab(2) + 'RegisterShortstringType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) + ',' +
                IntToStr(RI.Count) +
                ');' + '//' + IntToStr(KK));
            end;
            typePROC:
            begin
              Add2(Tab(2) + 'RegisterProceduralType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) + ',' +
                'H_SUB' +
               ');' + '//' + IntToStr(KK));
            end;
            typeEVENT:
            begin
              Add2(Tab(2) + 'RegisterEventType(' +
                StrLevelConst + ',' +
                StrLiteral(RI.Name) + ',' +
                'H_SUB' +
               ');' + '//' + IntToStr(KK));
            end;
            else
            begin
              if RI.TypeID = typeALIAS then
              begin
                Add2(Tab(2) + 'RegisterTypeAlias(' +
                  StrLevelConst + ',' +
                  StrLiteral(RI.Name) + ',' +
                  GetStrTypeConst(RI.PatternId) +
                  ');' + '//' + IntToStr(KK));
                continue;
              end;

              if (GTable[I + 1].Kind = kindCONST) and (GTable[I + 2].Kind = kindCONST) then
              begin // subrange type
                Add2(Tab(2) + 'RegisterSubrangeType(' +
                  StrLevelConst + ',' +
                  StrLiteral(RI.Name) + ',' +
                  GetStrTypeConst(RI.TypeId) + ',' +
                  IntToStr(GTable.GetLowBoundRec(I).Value) + ',' +
                  IntToStr(GTable.GetHighBoundRec(I).Value) +
                  ');' + '//' + IntToStr(KK));
              end;
            end;
          end;
        end;
      end;
    end;

    AddLine('{$O-}');

    AddLine('////////////////////////////////////////////////////////////////////////////');
    AddLine('// PaxCompiler import unit');
    AddLine('// The unit has been generated by paxCompiler importer');
    AddLine('// Site: http://www.paxcompiler.com');
    AddLine('// Author: Alexander Baranovsky (paxscript@gmail.com)');
    AddLine('// ========================================================================');
    AddLine('// Copyright (c) Alexander Baranovsky, 2006-2008. All rights reserved.');
    AddLine('////////////////////////////////////////////////////////////////////////////');

    AddLine('unit ' + ImportUnitName + ';');
    AddLine('interface');
    AddUnits;

    AddLine('procedure ' + RegProcName + ';');
    AddLine('implementation');

    for I:=0 to L1.Count - 1 do
      AddLine(L1[I]);

    for I:=0 to LP.Count - 1 do
      AddLine(LP[I]);

    AddLine('var H_NS, H_TYPE, H_SUB, H_READ, H_WRITE: Integer;');
    AddLine('var Undefined: Variant;');

    K := 1;

    AddLine('procedure P1;');
    AddLine('begin');

    for I:=0 to L2.Count - 1 do
    begin
      if I > 0 then if I mod MaxLines = 0 then
      begin
        AddLine('end;');
        Inc(K);
        AddLine('procedure P' + IntToStr(K) + ';');
        AddLine('begin');
      end;

      AddLine(L2[I]);
    end;
    AddLine('end;');

    AddLine('procedure ' + RegProcName + ';');
    AddLine('begin');

    for I:=1 to K do
      AddLine(Tab(2) + 'P' + IntToStr(I) + '();');

    for I:=0 to RegisteredClasses.Count - 1 do
    begin
      J := Integer(RegisteredClasses.Objects[I]);
      AddLine(Tab(2) + 'RegisterClassTypeInfos(' +
        IntToStr(J) + ',' +
        RegisteredClasses[I] +
        ');');
    end;

    AddLine('end;');

    AddLine('initialization');
    AddLine('  ' + RegProcName + ';');
    AddLine('end.');

  finally
    NewKernel.Free;

    L1.Free;
    L2.Free;
    LU.Free;
    LP.Free;

    RegisteredClasses.Free;
  end;
end;


end.
